home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / COPIA SITI / Getleft / getleft-setup-notcl.exe / {app} / scripts / balloon.tcl < prev    next >
Encoding:
Text File  |  2004-02-21  |  3.8 KB  |  138 lines
  1. ##############################################################################
  2. # balloon.tcl - procedures used by balloon help
  3. #
  4. # Copyright (C) 1996-1997 Stewart Allen
  5. # 
  6. # This is part of vtcl source code
  7. # Adapted for general purpose by 
  8. # Daniel Roche <daniel.roche@bigfoot.com>
  9. # thanks to D. Richard Hipp for the multi-headed display fix
  10. # version 1.2 ( Sep 21 2000 ) 
  11. #
  12. # Modified 15-Nov-2000 by Andres Garcia <fandom@retemail.es>
  13. #     - Wrapped it up in a namespace.
  14. #     - Added the 'delete_balloon' procedure to unbind a 
  15. #       widget to a balloon.
  16. #
  17. # Modified 14-Jan-01 by Andres Garcia <fandom@retemail.es>
  18. #     - Added a <destroy> binding to the Bulle class so
  19. #       that if a widget that has a balloon gets destroyed
  20. #       the balloon won't survive it.
  21. #
  22. # Modified 14-Aug-01 by Andres Garcia <fandom@reteamil.es>
  23. #     - I made sure there can be no balloon when going to
  24. #       show one.
  25. #
  26. # Modified 30-Aug-01 by Andres Garcia <fandom@reteamil.es>
  27. #     - The coordinates where the balloon is going to be shown
  28. #       get modified by the <Motion> event between entering the
  29. #       widget and the moment where the balloon is shown.
  30. #     - Put more vertical and less horizontal distance between
  31. #       the cursor and the balloon. Mainly because the hourglass
  32. #       in Windows would cover the balloon.
  33. #
  34. # This program is free software; you can redistribute it and/or
  35. # modify it under the terms of the GNU General Public License
  36. # as published by the Free Software Foundation; either version 2
  37. # of the License, or (at your option) any later version.
  38. #
  39. # This program is distributed in the hope that it will be useful,
  40. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  41. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  42. # GNU General Public License for more details.
  43. #
  44. # You should have received a copy of the GNU General Public License
  45. # along with this program; if not, write to the Free Software
  46. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  47. ##############################################################################
  48.  
  49. namespace eval BalloonHelp {
  50.  
  51. bind Bulle <Enter> {
  52.     set BalloonHelp::Bulle(x) %X
  53.     set BalloonHelp::Bulle(y) %Y
  54.     set BalloonHelp::Bulle(id) \
  55.             [after 500 {BalloonHelp::balloon %W}]
  56. }
  57.  
  58. bind Bulle <Leave> {
  59.     BalloonHelp::kill_balloon
  60. }
  61.  
  62. bind Bulle <Motion> {
  63.     set BalloonHelp::Bulle(x) %X
  64.     set BalloonHelp::Bulle(y) %Y
  65. }
  66.  
  67. bind Bulle <Button> {
  68.     BalloonHelp::kill_balloon
  69. }
  70.  
  71. bind Bulle <Destroy> {
  72.     BalloonHelp::delete_balloon %W
  73. }
  74.  
  75. proc set_balloon {target message} {
  76.     variable Bulle
  77.  
  78.     if {![info exists Bulle($target)]} {
  79.         bindtags $target "[bindtags $target] Bulle"
  80.     } else {
  81.         if {![string match $Bulle($target) $message]} {
  82.             catch {destroy .balloon}
  83.         }
  84.     }
  85.     set Bulle($target) $message
  86.  
  87.    return
  88. }
  89.  
  90. proc delete_balloon {target} {
  91.     variable Bulle
  92.  
  93.     if {![info exists Bulle($target)]} {
  94.         return
  95.     }
  96.     after cancel Bulle(id) 
  97.     unset Bulle($target)
  98.     set bindList   [bindtags $target]
  99.     set bulleIndex [lsearch $bindList Bulle]
  100.     set bindList   [lreplace $bindList $bulleIndex $bulleIndex]
  101.     bindtags $target $bindList
  102.  
  103.     catch {destroy .balloon}
  104.  
  105.     return
  106. }
  107.  
  108. proc kill_balloon {} {
  109.     variable Bulle
  110.  
  111.     after cancel $Bulle(id)
  112.     catch {destroy .balloon}
  113.  
  114.     return
  115. }
  116.  
  117. proc balloon {target} {
  118.     variable Bulle
  119.  
  120.     if {[catch {set Bulle($target)} message]} return
  121.     catch {destroy .balloon}
  122.  
  123.     set x $Bulle(x)
  124.     set y [expr {$Bulle(y) + 20}]
  125.  
  126.     toplevel .balloon -bg black -screen [winfo screen $target]
  127.     wm overrideredirect .balloon 1
  128.     label .balloon.l \
  129.             -text $message -relief flat \
  130.             -bg #ffffaa -fg black -padx 2 -pady 0 -anchor w
  131.     pack .balloon.l -side left -padx 1 -pady 1
  132.     wm geometry .balloon +${x}+${y}
  133.  
  134.     return
  135. }
  136.  
  137. }
  138.